Initial Set Up Steps
library(shinydashboard)
library(tidyverse)
library(leaflet)
library(shiny)
library(Rcpp)
library(sf)
library(tmaptools)
library(htmlwidgets)
library(googlesheets4)
library(RColorBrewer)
library(lubridate)
library(purrr)
library(shinythemes)
library(censusapi)
library(rgeos)
library(tidycensus)
library(tigris)
library(usmap)
library(colorspace)
library(ggplot2)
library(reshape2)
library(formattable)
library(plotly)
library(lubridate)
Sys.setenv(CENSUS_KEY="c8aa67e4086b4b5ce3a8717f59faa9a28f611dab")
github_directory <- "https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/"
github_rds <- "https://github.com/stanfordfuturebay/stanfordfuturebay.github.io/blob/master/data/"
options(
tigris_class = "sf",
tigris_use_cache = TRUE
)
mapbox_sat <- "https://api.mapbox.com/styles/v1/samanyl/ck9hpl0sm0fuq1ip8yfb2yrn8/tiles/256/{z}/{x}/{y}@2x?access_token=pk.eyJ1Ijoic2FtYW55bCIsImEiOiJjazlocGNvYWgxMHhxM2Rud2pxdzVnMnp2In0.D_j3K9tXiEddHH-8UUkeZQ"
mapbox_satAtt <- "© <a href='https://www.mapbox.com/map-feedback/'>Mapbox</a> Satellite Map"
bay_county_names <-
c(
"Alameda",
"Contra Costa",
"Marin",
"Napa",
"San Francisco",
"San Mateo",
"Santa Clara",
"Solano",
"Sonoma"
)
bay_counties <- readRDS(gzcon(url(paste0(github_rds,"bay_counties.rds?raw=true"))))
setwd("C:/Users/liusa/github/covid19/snap project/sam")
# bay_counties <-
# counties("CA", cb = F, progress_bar=F) %>%
# filter(NAME %in% bay_county_names)
#
# zctas <-
# zctas(cb=F)
#
# bay_zctas <-
# zctas %>%
# dplyr::select(ZCTA5CE10) %>%
# st_join(bay_counties %>% dplyr::select(geometry),left=F)
#
# saveRDS(bay_zctas, file = "bay_zctas.rds")
gs4_deauth()
retailers <- read_sheet("1tvMBCWNeh7kyyKklntmWfV1zNJx8bN-KxHIYmaULZxg")
retailers$long <- as.numeric(retailers$long)
retailers$lat <- as.numeric(retailers$lat)
snap <- retailers %>% filter(type == "SNAP_accepting_retailer")
wic <- retailers %>% filter(type == "WIC_only_store")
snap_wic <- retailers %>% filter(type == "WIC_SNAP_retailer")
snap_restaurant <- retailers %>% filter(type=="SNAP_restaurant")
snap_farmers <- retailers %>% filter(type=="SNAP_farmers_market")
snap_curbside <- snap %>% filter(!is.na(curbside_pickup))
wic_curbside <- wic %>% filter(!is.na(curbside_pickup))
snapwic_curbside <- snap_wic %>% filter(!is.na(curbside_pickup))
snaprest_curbside <- snap_restaurant %>% filter(!is.na(curbside_pickup))
snapfarm_curbside <- snap_farmers %>% filter(!is.na(curbside_pickup))
snap_delivery <- snap %>% filter(!is.na(delivery))
wic_delivery <- wic %>% filter(!is.na(delivery))
snapwic_delivery <- snap_wic %>% filter(!is.na(delivery))
snaprest_delivery <- snap_restaurant %>% filter(!is.na(delivery))
snapfarm_delivery <- snap_farmers %>% filter(!is.na(delivery))
snap_senior <- snap %>% filter(!is.na(senior_hours))
wic_senior <- wic %>% filter(!is.na(senior_hours))
snapwic_senior <- snap_wic %>% filter(!is.na(senior_hours))
snaprest_senior <- snap_restaurant %>% filter(!is.na(senior_hours))
snapfarm_senior <- snap_farmers %>% filter(!is.na(senior_hours))
snapIcon <- makeIcon(
iconUrl = "baymap/bag.png",
iconWidth=25,iconHeight=25)
wicIcon <- makeIcon(
iconUrl = "baymap/love.png",
iconWidth=30,iconHeight=30)
snapwicIcon <- makeIcon(
iconUrl = "baymap/snapwic.png",
iconWidth=30,iconHeight=30)
snaprestIcon <- makeIcon(
iconUrl = "baymap/cutlery.png",
iconWidth=25,iconHeight=25)
snapfarmIcon <- makeIcon(
iconUrl = "baymap/chicken.png",
iconWidth=25,iconHeight=25)
homeIcon <- makeIcon(
iconUrl = "baymap/internet.png",
iconWidth=25,iconHeight=25)
html_legend <- "<img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/bag.png' height='30' width='30'> SNAP Only Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/love.png' height='30' width='30'> WIC Only Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/snapwic.png' height='30' width='30'> SNAP and WIC Accepting Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/money.png' height='30' width='30'> Cash EBT Withdrawal Locations<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/cutlery.png' height='30' width='30'> SNAP Accepting Restaurants<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/chicken.png' height='30' width='30'> SNAP Accepting Farmers Markets"
cluster <-
markerClusterOptions(
showCoverageOnHover=F,
spiderfyOnMaxZoom=F,
disableClusteringAtZoom=14
)
# time format --> format(dataset$____, %I:%M%p)
pop <- function(dataset){
result <-
paste0(
ifelse(
is.na(dataset$web_link),
paste0("<strong>",dataset$site_name,"</strong><br>"),
paste0("<a href='",dataset$web_link,"' target='_blank'><strong>",dataset$site_name,"</strong></a><br>")
),
dataset$address, "<br>",
dataset$city,", ",
dataset$state," ",
dataset$zip,
"<br><br><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/pin.png' height='12' width='12'>
<a href='https://www.google.com/maps/dir/?api=1&destination=",
dataset$lat,",",
dataset$long,"' target='_blank'>Directions To Here</a>",
'<br><br><strong>Hours of Operation: </strong><br>',
dataset$days_hours_line1,
ifelse(
is.na(dataset$days_hours_line2),
"",
paste0("<br>",dataset$days_hours_line2)
),
ifelse(
is.na(dataset$days_hours_line3),
"",
paste0("<br>",dataset$days_hours_line3)
),
ifelse(
is.na(dataset$days_hours_line4),
"",
paste0("<br>",dataset$days_hours_line4)
),
"<br><br><strong>Contact Information:</strong><br>",
ifelse(
is.na(dataset$web_link),
"",
paste0("<a href='",dataset$web_link,"' target='_blank'>Website</a><br>")
),
dataset$phone,"<br>",
ifelse(
is.na(dataset$notes),
"",
paste0("<br><strong>Notes: </strong>",dataset$notes,"<br>")
),
ifelse(
is.na(dataset$senior_hours),
"",
paste0(
'<br><strong style="color:red">** SPECIAL SENIOR HOURS ** </strong><br>',
dataset$senior_hours)
)
)
return(result)
}
bay_zctas <- readRDS("P:/Stanford/Classes/CEE218Z - Shaping the Future of the Bay/bay_zctas.rds")
wd <- "P:/Shared/SFBI/Restricted Data Library/Safegraph/covid19analysis/transactions-facteus/"
combining <- function(pattern) {
files <- list.files(pattern = pattern)
return(do.call(rbind, lapply(files,readRDS)))
}
spending_total <- readRDS(paste0(wd,"cut-1-daily-spend-by-zip/2020-04-22/cut-1-daily-spend-by-zip-20170101-20200417-bay.rds"))
setwd(paste0(wd,"cut-2-daily-spend-by-zip-by-mcc/2020-04-22"))
spending_MCC <-
combining("cut-2-daily-spend-by-zip-by-mcc-20170101-20200417-[0-1][0-9]-bay.rds")
setwd(paste0(wd,"cut-3-daily-spend-by-brand/2020-04-22"))
spending_brand <- combining("daily-spend-by-brand-20170101-20200417-[0-1][0-9]-bay.rds")
walmart_instore <- readRDS(paste0(wd,"cut-4-daily-spend-at-walmart/2020-04-22/daily-spend-by-zip-walmart-instore-20170101-20200417-bay.rds"))
walmart_online <- readRDS(paste0(wd,"cut-4-daily-spend-at-walmart/2020-04-22/daily-spend-by-zip-walmart-online-20170101-20200417-bay.rds"))
gcf <- read.csv("P:/Shared/SFBI/Restricted Data Library/CalFresh/last_365_by_zip.csv")
setwd("C:/Users/liusa/github/covid19/snap project/sam")
Leaflet Snap Circle Icons
cols <- brewer.pal(5, name='Set1')
retail.col <- colorFactor(cols, domain = c("SNAP_accepting_retailer","WIC_only_store","WIC_SNAP_retailer","SNAP_restaurant",
"SNAP_farmers_market"))
mpc <- leaflet() %>%
addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
addCircleMarkers(
lng = retailers$long,
lat = retailers$lat,
color = retail.col(retailers$type),
radius = 5,
popup = pop(retailers)
) %>%
addLegend(
position = 'bottomleft',
values = subset(retailers$type,!is.na(retailers$type)),
na.label = "",
pal = retail.col,
title='Stores'
) %>%
addLayersControl(
baseGroups = c("Default","Satellite")
)
mpc
Leaflet Snap with Flat Icons
mpi <- leaflet() %>%
addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
# addProviderTiles(providers$CartoDB.Positron, group = "Positron") %>% # add mapbox
addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
addMarkers(
lng = snap$long,
lat = snap$lat,
clusterOptions = cluster,
popup = pop(snap),
icon = snapIcon,
group = "SNAP Only Retailers"
) %>%
addMarkers(
lng = wic$long,
lat = wic$lat,
clusterOptions = cluster,
popup = pop(wic),
icon = wicIcon,
group = "WIC Only Retailers"
) %>%
addMarkers(
lng = snap_wic$long,
lat = snap_wic$lat,
clusterOptions = cluster,
popup = pop(snap_wic),
icon = snapwicIcon,
group = "SNAP and WIC Accepting Retailers"
) %>%
addMarkers(
lng = snap_restaurant$long,
lat = snap_restaurant$lat,
clusterOptions = cluster,
popup = pop(snap_restaurant),
icon = snaprestIcon,
group = "SNAP Accepting Restaurants"
) %>%
addMarkers(
lng = snap_farmers$long,
lat = snap_farmers$lat,
clusterOptions = cluster,
popup = pop(snap_farmers),
icon = snapfarmIcon,
group = "SNAP Accepting Farmers Markets"
) %>%
addMarkers(
lng = snap_curbside$long,
lat = snap_curbside$lat,
clusterOptions = cluster,
popup = pop(snap_curbside),
icon = snapIcon,
group = "Offers Curbside Pick-up"
) %>%
addMarkers(
lng = wic_curbside$long,
lat = wic_curbside$lat,
clusterOptions = cluster,
popup = pop(wic_curbside),
icon = wicIcon,
group = "Offers Curbside Pick-up"
) %>%
addMarkers(
lng = snapwic_curbside$long,
lat = snapwic_curbside$lat,
clusterOptions = cluster,
popup = pop(snapwic_curbside),
icon = snapwicIcon,
group = "Offers Curbside Pick-up"
) %>%
addMarkers(
lng = snaprest_curbside$long,
lat = snaprest_curbside$lat,
clusterOptions = cluster,
popup = pop(snaprest_curbside),
icon = snaprestIcon,
group = "Offers Curbside Pick-up"
) %>%
addMarkers(
lng = snapfarm_curbside$long,
lat = snapfarm_curbside$lat,
clusterOptions = cluster,
popup = pop(snapfarm_curbside),
icon = snapfarmIcon,
group = "Offers Curbside Pick-up"
) %>%
addMarkers(
lng = snap_delivery$long,
lat = snap_delivery$lat,
clusterOptions = cluster,
popup = pop(snap_delivery),
icon = snapIcon,
group = "Offers CSA Box Delivery"
) %>%
addMarkers(
lng = wic_delivery$long,
lat = wic_delivery$lat,
clusterOptions = cluster,
popup = pop(wic_delivery),
icon = wicIcon,
group = "Offers CSA Box Delivery"
) %>%
addMarkers(
lng = snapwic_delivery$long,
lat = snapwic_delivery$lat,
clusterOptions = cluster,
popup = pop(snapwic_delivery),
icon = snapwicIcon,
group = "Offers CSA Box Delivery"
) %>%
addMarkers(
lng = snaprest_delivery$long,
lat = snaprest_delivery$lat,
clusterOptions = cluster,
popup = pop(snaprest_delivery),
icon = snaprestIcon,
group = "Offers CSA Box Delivery"
) %>%
addMarkers(
lng = snapfarm_delivery$long,
lat = snapfarm_delivery$lat,
clusterOptions = cluster,
popup = pop(snapfarm_delivery),
icon = snapfarmIcon,
group = "Offers CSA Box Delivery"
) %>%
addMarkers(
lng = snap_senior$long,
lat = snap_senior$lat,
clusterOptions = cluster,
popup = pop(snap_senior),
icon = snapIcon,
group = "Offers Senior Hours"
) %>%
addMarkers(
lng = wic_senior$long,
lat = wic_senior$lat,
clusterOptions = cluster,
popup = pop(wic_senior),
icon = wicIcon,
group = "Offers Delivery"
) %>%
addMarkers(
lng = snapwic_senior$long,
lat = snapwic_senior$lat,
clusterOptions = cluster,
popup = pop(snapwic_senior),
icon = snapwicIcon,
group = "Offers Delivery"
) %>%
addMarkers(
lng = snaprest_senior$long,
lat = snaprest_senior$lat,
clusterOptions = cluster,
popup = pop(snaprest_senior),
icon = snaprestIcon,
group = "Offers Delivery"
) %>%
addMarkers(
lng = snapfarm_senior$long,
lat = snapfarm_senior$lat,
clusterOptions = cluster,
popup = pop(snapfarm_senior),
icon = snapfarmIcon,
group = "Offers Delivery"
) %>%
addLayersControl(
baseGroups = c("Default","Satellite"),
overlayGroups = c("SNAP Only Retailers","WIC Only Retailers","SNAP and WIC Accepting Retailers","Cash EBT Withdrawal Locations",
"SNAP Accepting Restaurants","SNAP Accepting Farmers Markets",
"Offers Curbside Pick-up", "Offers Delivery","Offers Senior Hours")
) %>%
addControl(
html=html_legend,
position="bottomleft") %>%
hideGroup(c("Offers Curbside Pick-up", "Offers Delivery","Offers Senior Hours"))
mpi
2019 vs 2020 Spending Trends Between January and April
# spending distribution of products (bar charts)
# spending_MCC_sum <-
# spending_MCC %>%
# mutate(year=substr(date,1,4)) %>%
# mutate(month = substr(date,6,7)) %>%
# group_by(year,month,MCC) %>%
# summarize(
# mean=mean(as.numeric(total_spent)),
# sum=sum(as.numeric(total_spent)),
# transactions=sum(as.numeric(transaction_counts)),
# avg_transactions=mean(as.numeric(transaction_counts)))
#
# spending_MCC_1920 <-
# spending_MCC_sum %>%
# filter(year %in% c("2019","2020"), month %in% c("01","02","03","04"), MCC > 0)
#
# spending_MCC_1920 <-
# spending_MCC_1920[order(spending_MCC_1920$MCC),]
#
# spending_MCC_1920 <-
# spending_MCC_1920[-c(1,2,3,4),]
#
# saveRDS(spending_MCC_1920,"baymap/spending_MCC_1920.rds")
#
# mcc_codes <-
# read_csv("https://raw.githubusercontent.com/greggles/mcc-codes/master/mcc_codes.csv") %>%
# dplyr::select(
# MCC = mcc,
# label = edited_description
# ) %>%
# saveRDS("baymap/mcc_codes.rds")
spending_MCC_1920 <- readRDS("baymap/spending_MCC_1920.rds")
mcc_codes <- readRDS("baymap/mcc_codes.rds")
plot_month <- function(m,abbr) {
spend20 <-
spending_MCC_1920 %>%
filter(month==m,year=="2020")
spend1920 <-
spending_MCC_1920 %>%
filter(month==m,year=="2019") %>%
right_join(spend20,by=c("MCC","month"),suffix=c("_2019","_2020")) %>%
filter(!is.na(transactions_2019) & !is.na(transactions_2020) & !is.na(year_2019) & !is.na(year_2020)) %>%
arrange(transactions_2020)
spend1920 <-
spend1920 %>%
tail(10) %>%
dplyr::select(year_2019,year_2020,transactions_2019,transactions_2020,MCC)
spend1920 <- spend1920[c("MCC", "year_2019", "year_2020", "transactions_2019", "transactions_2020")]
spend20 <-
spend1920 %>%
dplyr::select(year_2020,transactions_2020,MCC) %>%
dplyr::rename("year" = "year_2020","transactions"="transactions_2020")
spend19 <-
spend1920 %>%
dplyr::select(year_2019,transactions_2019,MCC) %>%
dplyr::rename("year" = "year_2019","transactions"="transactions_2019")
spend1920_plt <-
spend19 %>%
full_join(spend20) %>%
left_join(mcc_codes,by=("MCC")) %>%
ungroup()
plt <-
(ggplot(spend1920_plt,aes(x=MCC,y=transactions,fill=year,group=year,text=paste0(label,": ",transactions))) +
scale_fill_brewer(palette="Paired") +
geom_bar(stat="identity",position=position_dodge()) +
labs(title=abbr,y= "MCC", x = "Total Transactions", color="Legend") +
coord_flip() +
theme_minimal() +
theme(legend.position = "top")) %>%
ggplotly(tooltip="text") %>%
config(displayModeBar = F)%>%
layout(legend = list(orientation="h",x = 0.4, y = 1.1))
spend1920_tbl <-
spend1920 %>%
left_join(mcc_codes,by=("MCC")) %>%
dplyr::select(MCC, label, transactions_2019,transactions_2020) %>%
arrange(MCC) %>%
dplyr::rename("2019" = "transactions_2019","2020"="transactions_2020","Description"="label") %>%
formattable(align = c("c","l","c","c"))
values <- list("plt" = plt,"tbl" = spend1920_tbl)
return(values)
}
jan <- plot_month("01","Jan")
jan$plt
jan$tbl
|
MCC
|
Description
|
2019
|
2020
|
|
4121
|
Taxicabs and Limousines
|
81206
|
74901
|
|
4829
|
Money Orders – Wire Transfer
|
13581
|
43782
|
|
5411
|
Grocery Stores, Supermarkets
|
152744
|
189982
|
|
5499
|
Misc. Food Stores – Convenience Stores and Specialty Markets
|
40627
|
49610
|
|
5541
|
Service Stations ( with or without ancillary services)
|
130722
|
189541
|
|
5542
|
Automated Fuel Dispensers
|
44456
|
43278
|
|
5812
|
Eating places and Restaurants
|
139639
|
150149
|
|
5814
|
Fast Food Restaurants
|
236911
|
300474
|
|
5999
|
Miscellaneous and Specialty Retail Stores
|
204483
|
179750
|
|
6011
|
Financial Institutions – Manual Cash Disbursements
|
45488
|
66778
|
feb <- plot_month("02","Feb")
feb$plt
feb$tbl
|
MCC
|
Description
|
2019
|
2020
|
|
4121
|
Taxicabs and Limousines
|
84758
|
89658
|
|
4829
|
Money Orders – Wire Transfer
|
15253
|
44139
|
|
5411
|
Grocery Stores, Supermarkets
|
151210
|
160088
|
|
5499
|
Misc. Food Stores – Convenience Stores and Specialty Markets
|
41143
|
56096
|
|
5541
|
Service Stations ( with or without ancillary services)
|
125513
|
142621
|
|
5542
|
Automated Fuel Dispensers
|
42562
|
49137
|
|
5812
|
Eating places and Restaurants
|
144215
|
186259
|
|
5814
|
Fast Food Restaurants
|
236745
|
301869
|
|
5999
|
Miscellaneous and Specialty Retail Stores
|
203356
|
325414
|
|
6011
|
Financial Institutions – Manual Cash Disbursements
|
47793
|
85592
|
mar <- plot_month("03","Mar")
mar$plt
mar$tbl
|
MCC
|
Description
|
2019
|
2020
|
|
4121
|
Taxicabs and Limousines
|
100191
|
68208
|
|
4829
|
Money Orders – Wire Transfer
|
18707
|
48890
|
|
5411
|
Grocery Stores, Supermarkets
|
170894
|
180237
|
|
5499
|
Misc. Food Stores – Convenience Stores and Specialty Markets
|
50274
|
59528
|
|
5541
|
Service Stations ( with or without ancillary services)
|
148208
|
140964
|
|
5735
|
Record Shops
|
23904
|
46108
|
|
5812
|
Eating places and Restaurants
|
177563
|
148624
|
|
5814
|
Fast Food Restaurants
|
284305
|
261753
|
|
5999
|
Miscellaneous and Specialty Retail Stores
|
243923
|
310774
|
|
6011
|
Financial Institutions – Manual Cash Disbursements
|
56766
|
79597
|
apr <- plot_month("04","Apr")
apr$plt
apr$tbl
|
MCC
|
Description
|
2019
|
2020
|
|
4829
|
Money Orders – Wire Transfer
|
19355
|
37603
|
|
5411
|
Grocery Stores, Supermarkets
|
162668
|
89860
|
|
5499
|
Misc. Food Stores – Convenience Stores and Specialty Markets
|
50755
|
30979
|
|
5541
|
Service Stations ( with or without ancillary services)
|
145971
|
70446
|
|
5735
|
Record Shops
|
29313
|
28662
|
|
5812
|
Eating places and Restaurants
|
166319
|
61977
|
|
5814
|
Fast Food Restaurants
|
282207
|
107498
|
|
5942
|
Book Stores
|
26974
|
25455
|
|
5999
|
Miscellaneous and Specialty Retail Stores
|
258077
|
129933
|
|
6011
|
Financial Institutions – Manual Cash Disbursements
|
56793
|
41980
|
Online vs. Instore Spending Trends Due to SIP Orders
# compare instore to online ratio and potential for the online shift before and after covid
# transactions_ratio >> on a given day, ___ times more people shop instores rather than online (2 line graph showing the trend before and after covid and online vs instore trends)
# walmart_instore_sum <-
# walmart_instore %>%
# mutate(month = substr(date,1,7)) %>%
# group_by(month) %>%
# summarize(
# mean=mean(as.numeric(total_spent)),
# sum=sum(as.numeric(total_spent)),
# avg_transactions=mean(as.numeric(transaction_counts)),
# transactions=sum(as.numeric(transaction_counts)))
#
# walmart_sum <-
# walmart_online %>%
# mutate(month = substr(date,1,7)) %>%
# group_by(month) %>%
# summarize(
# mean=mean(as.numeric(total_spent)),
# sum=sum(as.numeric(total_spent)),
# avg_transactions=mean(as.numeric(transaction_counts)),
# transactions=sum(as.numeric(transaction_counts))) %>%
# left_join(walmart_instore_sum,by="month",suffix=c("_online","_instore"))
#
# walmart_melt <-
# walmart_sum %>%
# tail(13) %>%
# mutate(transactions_ratio_instore=(avg_transactions_instore)/(sum(walmart_sum[, 'avg_transactions_instore']))) %>%
# mutate(transactions_ratio_online=(avg_transactions_online)/(sum(walmart_sum[, 'avg_transactions_online']))) %>%
# dplyr::select(month,transactions_ratio_instore,transactions_ratio_online) %>%
# melt(id=c("month"))
#
# saveRDS(walmart_melt,"baymap/walmart_transactions.rds")
walmart_melt <- readRDS("baymap/walmart_transactions.rds")
wplt <-
ggplot(walmart_melt,aes(x=month,y=value,color=variable,group=variable)) +
geom_line(size=1.5) +
labs(y= "Transactions Ratio", x = "Date", color="Legend") +
theme(axis.text.y =element_blank(),
axis.ticks.y=element_blank())
wplt

# instore1920 <-
# walmart_instore %>%
# mutate(year = substr(date,1,4)) %>%
# mutate(month = substr(date,6,7)) %>%
# mutate(day = substr(date,9,10)) %>%
# filter(year %in% c("2019","2020")) %>%
# group_by(year,month) %>%
# summarize(
# avg_transactions=mean(as.numeric(transaction_counts))) %>%
# spread(year,avg_transactions) %>%
# mutate(transactions_ratio=`2020`/`2019`) %>%
# gather("year",transactions_ratio,2:3)
#
# instore_online_1920 <-
# walmart_online %>%
# mutate(year = substr(date,1,4)) %>%
# mutate(day = substr(date,9,10)) %>%
# mutate(month = substr(date,6,7)) %>%
# filter(year %in% c("2019","2020")) %>%
# group_by(year,month) %>%
# summarize(
# avg_transactions=mean(as.numeric(transaction_counts))) %>%
# spread(year,avg_transactions) %>%
# mutate(transactions_ratio=`2020`/`2019`) %>%
# gather("year",transactions_ratio,2:3) %>%
# left_join(instore1920,suffix=c("_online","_instore"),by=c("year","month")) %>%
# unite(year_month,year,month,sep="-") %>%
# dplyr::select(year_month,transactions_ratio_online,transactions_ratio_instore) %>%
# melt(id=c("year_month")) %>%
# na.omit()
#
# saveRDS(instore_online_1920,"baymap/instore_online_1920.rds")
instore_online_1920 <- readRDS("baymap/instore_online_1920.rds")
ioplt <-
ggplot(instore_online_1920,aes(x=year_month,y=value,color=variable,group=1)) +
geom_line(size=1) +
labs(y= "Daily Avg Transactions", x = "Date", color="Legend")
ioplt %>% ggplotly()
# instore_ratio_1920 <-
# walmart_instore %>%
# mutate(year = substr(date,1,4)) %>%
# mutate(month = substr(date,6,7)) %>%
# mutate(day = substr(date,9,10)) %>%
# filter(year %in% c("2019","2020")) %>%
# group_by(year,month) %>%
# summarize(
# avg_transactions=mean(as.numeric(transaction_counts))) %>%
# spread(year,avg_transactions) %>%
# mutate(transactions_ratio=`2020`/`2019`)
#
# inon_ratio_1920 <-
# walmart_online %>%
# mutate(year = substr(date,1,4)) %>%
# mutate(day = substr(date,9,10)) %>%
# mutate(month = substr(date,6,7)) %>%
# filter(year %in% c("2019","2020")) %>%
# group_by(year,month) %>%
# summarize(
# avg_transactions=mean(as.numeric(transaction_counts))) %>%
# spread(year,avg_transactions) %>%
# mutate(transactions_ratio=`2020`/`2019`) %>%
# left_join(instore1920,suffix=c("_online","_instore"),by=c("month")) %>%
# dplyr::select(month,transactions_ratio_online,transactions_ratio_instore) %>%
# melt(id=c("month")) %>%
# na.omit()
#
# saveRDS(inon_ratio_1920,"baymap/inon_ratio_1920.rds")
#
# inon_ratio_1920 <- readRDS("baymap/inon_ratio_1920.rds")
#
# inonplt <-
# ggplot(instore_online_1920,aes(x="month",y=value,color=variable,group=1)) +
# geom_line(size=1) +
# labs(y= "Transactions Ratio", x = "Month", color="Legend")
#
# inonplt %>% ggplotly()
Grocers Spending Trends Over the Years
# grocery spending impacts due to covid (line graphs by MCC) - show trends over the years
# spending_grocers <-
# spending_MCC %>%
# filter(MCC=="5411") %>%
# saveRDS("baymap/spending_grocers.rds")
# spending_grocers <- readRDS("baymap/spending_grocers.rds")
#
# spending_grocers_annual <-
# spending_grocers %>%
# filter(month(date)<=5) %>%
# group_by(year(date),month(date)) %>%
# summarize(
# mean=mean(as.numeric(total_spent))
# ) %>%
# arrange(`month(date)`)
# saveRDS(spending_grocers_annual,"baymap/spending_grocers_annual.rds")
spending_grocers_annual <- readRDS("baymap/spending_grocers_annual.rds")
grocer_annual <-
(ggplot(spending_grocers_annual,aes(x=as.character(`month(date)`),y=mean, color=as.character(`year(date)`), group=as.character(`year(date)`), text=paste0("$", round(mean,2)))) +
geom_line(size=1) +
geom_point(size=1.5) +
scale_x_discrete(labels=c("1"="Jan","2" = "Feb", "3" = "Mar", "4" = "Apr", "5" = "May")) +
labs(y= "Average Monthly Spendings on Groceries ($)", x = "Date", color="Legend") +
theme_minimal() +
theme(legend.position="top")) %>%
ggplotly(tooltip="text") %>%
config(displayModeBar = F) %>%
layout(legend = list(orientation="h",x = 0.4, y = 1.1))
grocer_annual
# spending_grocers_covid <-
# spending_grocers %>%
# filter(month(date)<=5) %>%
# saveRDS("baymap/spending_grocers_covid.rds")
spending_grocers_covid <- readRDS("baymap/spending_grocers_covid.rds")
# spending_grocers_byweek <-
# spending_grocers_covid %>%
# group_by(week = week(date),year(date)) %>%
# summarize(
# mean=mean(as.numeric(total_spent))
# ) %>%
# saveRDS("baymap/spending_grocers_byweek.rds")
spending_grocers_byweek <- readRDS("baymap/spending_grocers_byweek.rds")
grocer_weekly <-
(ggplot(spending_grocers_byweek,aes(x=week,y=mean, color=as.character(`year(date)`),group=as.character(`year(date)`),text=paste0("Week ", week,": $", round(mean,2)))) +
geom_line(size=1) +
geom_point(size=1.5) +
scale_x_continuous(breaks = seq(1, 22, by = 4)) +
labs(y= "Average Weekly Spendings on Groceries ($)", x = "Week Number", color="Legend") +
theme_minimal() +
theme(legend.position="top")) %>%
ggplotly(tooltip="text") %>%
config(displayModeBar = F) %>%
layout(legend = list(orientation="h",x = 0.4, y = -0.1))
grocer_weekly
# spending_grocers_weekday <-
# spending_grocers_covid %>%
# group_by(wday(date),date,year(date)) %>%
# summarize(
# mean=mean(as.numeric(total_spent))
# ) %>%
# saveRDS("baymap/spending_grocers_weekday.rds")
spending_grocers_weekday <- readRDS("baymap/spending_grocers_weekday.rds")
grocer_weekday <-
(ggplot(spending_grocers_weekday, aes(x=as.character(`wday(date)`),y=mean, fill=as.character(`year(date)`),group=as.character(`year(date)`), text=paste0("$", round(mean,2)))) +
geom_bar(stat="identity",position=position_dodge()) +
scale_x_discrete(labels=c("1"="Sun","2" = "Mon", "3" = "Tues", "4" = "Wed", "5" = "Thurs", "6" = "Fri","7"="Sat")) +
labs(y= "Average Daily Spendings on Groceries ($)", x = "Weekday", fill="Legend") +
theme_minimal() +
theme(legend.position="top")) %>%
ggplotly(tooltip="text") %>%
config(displayModeBar = F) %>%
layout(legend = list(orientation="h",x = 0.4, y = -0.1))
grocer_weekday
Walmart vs. SNAP Demographics
## most popular/accessible walmart among zipcodes (plot number of transactions on map)
bay_zipcodes <-
read.csv("baymap/bayarea_zipcodes.csv") %>%
dplyr::select(PO_NAME,ZIP)
bay_zipcodes$ZIP <- as.character(bay_zipcodes$ZIP)
# spending_brand_sum <-
# bay_zipcodes %>%
# left_join(spending_brand %>% filter(merchant=="WALMART"),by=c("ZIP"="zip")) %>%
# group_by(merchant,ZIP,PO_NAME) %>%
# summarize(
# transactions_avg=round(mean(as.numeric(transaction_counts)))) %>%
# left_join(bay_zctas,by=c("ZIP"="ZCTA5CE10")) %>%
# distinct(ZIP,.keep_all = T) %>%
# st_as_sf(dim = "XY", sf_column_name = "geometry") %>%
# st_transform(crs=4326) %>%
# mutate(combined=paste0(ZIP,": ",round(transactions_avg)," Daily Avg Walmart Transactions")) %>%
# na.omit()
#
# spending_brand_sum <- spending_brand_sum[order(spending_brand_sum$transactions_avg),]
#
# saveRDS(spending_brand_sum,"baymap/spending_brand_sum.rds")
#
# gcf["zip"] <- as.character(gcf$zip)
#
# gcf_bay <-
# gcf %>%
# right_join(bay_zctas,by=c("zip"="ZCTA5CE10")) %>%
# filter(zip %in% spending_brand_sum$ZIP) %>%
# distinct(zip,.keep_all = T) %>%
# st_as_sf(dim = "XY", sf_column_name = "geometry") %>%
# st_transform(crs=4326) %>%
# mutate(combined=paste0(zip,": ",total_individuals, " SNAP Residents")) %>%
# na.omit()
#
# gcf_bay <- gcf_bay[order(gcf_bay$total_individuals),]
#
# saveRDS(gcf_bay,"baymap/gcf_bay.rds")
spending_brand_sum <- readRDS("baymap/spending_brand_sum.rds")
spending_brand_sum_top10 <- tail(spending_brand_sum,10)
spending_brand_sum_top25 <- tail(spending_brand_sum,25)
spending_brand_sum_top50 <- tail(spending_brand_sum,50)
gcf_bay <- readRDS("baymap/gcf_bay.rds")
gcf_bay_top10 <- tail(gcf_bay,10)
gcf_bay_top25 <- tail(gcf_bay,25)
gcf_bay_top50 <- tail(gcf_bay,50)
col <- c("#068a9c","#d44a1e")
fp <- leaflet() %>%
addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
addPolygons(
data = spending_brand_sum_top10,
weight=2,
color = "#5c2a9d",
label = spending_brand_sum_top10$combined,
group = "Walmart Top 10"
) %>%
addPolygons(
data = spending_brand_sum_top25,
weight=2,
color = "#5c2a9d",
label = spending_brand_sum_top25$combined,
group = "Walmart Top 25"
) %>%
addPolygons(
data = spending_brand_sum_top50,
color = "#5c2a9d",
weight=2,
label = spending_brand_sum_top50$combined,
group = "Walmart Top 50"
) %>%
addPolygons(
data = gcf_bay_top10,
weight=2,
color = "#e2598b",
label = gcf_bay_top10$combined,
group = "SNAP Top 10"
) %>%
addPolygons(
data = gcf_bay_top25,
weight=2,
color = "#e2598b",
label = gcf_bay_top25$combined,
group = "SNAP Top 25"
) %>%
addPolygons(
data = gcf_bay_top50,
color = "#e2598b",
weight=2,
label = gcf_bay_top50$combined,
group = "SNAP Top 50"
) %>%
addLayersControl(
baseGroups = c("Default","Satellite"),
overlayGroups = c("Walmart Top 10","Walmart Top 25","Walmart Top 50",
"SNAP Top 10","SNAP Top 25", "SNAP Top 50")
) %>%
hideGroup(c("Walmart Top 10","Walmart Top 50","SNAP Top 10","SNAP Top 50"))
fp
walsnap_tbl <-
gcf_bay_top50 %>%
dplyr::select(-geometry) %>%
as.data.frame() %>%
left_join(spending_brand_sum_top50 %>% dplyr::select(-geometry) %>% as.data.frame(), by=c("zip"="ZIP"),suffix=c("_SNAP","_walmart")) %>%
na.omit() %>%
dplyr::select(zip,total_individuals,transactions_avg) %>%
left_join(bay_zipcodes, by=c("zip"="ZIP")) %>%
arrange(desc(transactions_avg)) %>%
dplyr::rename("Zip"="zip","CITY"="PO_NAME","SNAP Residents"="total_individuals","Daily Avg Walmart Transactions"="transactions_avg") %>%
formattable(align = c(rep("c")),list(area(col = 2:2) ~ color_tile("#ffffff", "#eab9c9"),area(col = 3:3) ~ color_tile("#ffffff", "#c9b6e4"))) %>%
as.datatable()
walsnap_tbl
Shiny App Implementation
wplt
# body_bay <-
# sidebarLayout(
# position="right",
# sidebarPanel(
# width=2,
# textInput("address","Input Address:"),
# sliderInput("slider", "Miles Radius:", 1, 3, 2),
# actionButton("go",label="Go")
# ),
# mainPanel(
# width=10,
# splitLayout(
# cellWidths = c("25%","75%"),
# cellArgs = list(
# style='white-space: normal;',
# style='overflow: hidden;',
# style='padding: 10px;'),
# verticalLayout(
# h4(strong("About the Map")),
# p("This map highlights the key opportunities for SNAP online integration around the San Francisco Bay Area. Each icon represents different SNAP accepting retailers as well as WIC."),
# h4(strong("How To Use the Map")),
# HTML(
# "<ol>
# <li>Scroll up and down to zoom in and out of the map</li>
# <li>Filter through different retailers through layers icon in the top right corner of the map</li>
# <li>Use the inputs from the right sidebar to zoom into a specific address with a 1, 2, or 3 mile-radius</li>
# </ol>"
# ),
# br(),
# p(strong("Disclaimer: "),"This map is not intended to substitute an all-encompassing resources map. For that, please go to this ", a("link", href="https://www.bayareacommunity.org/#/"),".",style="font-size:14px"),
# br(),
# p("Created by Samantha Liu for the ",a("Stanford Future Bay Initiative",href="http://bay.stanford.edu/covid19?utm_campaign=ConsortiumUpdate-5.18.20&utm_medium=email&utm_source=autopilot"),style="font-size:12px")
# ),
# leafletOutput("snapmap",height="75vh")
# )
# )
# )
# body_shopping <-
# tabBox(
# id = "tabset2",
# width=12,
# tabPanel(
# "About the Data",
# style="padding: 20px",
# h4("Purpose of this Analysis"),
# p("The purpose of this analysis is to predict the number of potential people impacted by Walmart's recent ",a("Online SNAP Program",href="https://www.walmart.com/ideas/discover-grocery-pickup-delivery/walmart-grocery-pickup-accepts-snap-ebt-payments/355540")," launch. Until this program launched, SNAP beneficiaries did not have the luxury to buy their groceries online. This means SNAP recipients have higher risks of either contracting or passing on the virus during shelter-in-place orders. Even if this program turns out to not be not highly utilized, it is extremely important that every person has the equal opportunity to access grocery deliveries after COVID-19 passes."),
# br(),
# h4("Data Sources"),
# p("This transaction dataset is primarily from three sources: "),
# HTML("<ul>
# <li>Challenger Banks - Simple, N26, etc.</li>
# <li>Payroll Cards</li>
# <li>Government Cards</li>
# </ul>"),
# p("Because of this, it's mostly tracking the purchase patterns of lower-income and younger consumers."),
# br(),
# p(em("Challenger banks"),"are newer smaller banks that mostly serve people who are under-banked. They are usually online-only."),
# p(em("Payroll cards"),"are debit cards given to employees by employers who can then direct debit their payroll onto those cards."),
# p(em("Government cards"),"are mostly cards given to an alimony recipient to allow them access to funds obtained by garnishing a wage.")
# ),
# tabPanel(
# "In-store vs. Online",
# style="padding: 20px",
# fluidRow(
# column(6,plotOutput("transactions")),
# column(6, p("In this first graph, we can observe the relative change of online purchases and instore purchases at Walmart around the Bay Area once shelter-in-place (SIP) orders have been enacted. There is a sharp decrease in instore purchases and a rapid increase in online purchases. With this, we can see the behavioral effects of SIP.",style="text-align: justify"))
# ),
# fluidRow(
# column(6,plotlyOutput("transactions2")),
# column(6,p("In this second graph, we can observe the daily average 2020 to 2019 transactions ratio of both online and instore Walmart Transactions. It confirms the conclusions of the first graph.", style="text-align: justify"))
# )
# ),
# tabPanel(
# "Monthly Spendings",
# splitLayout(
# cellArgs = list(
# style='white-space: normal;',
# style='overflow: hidden;',
# style='padding: 20px;'
# ),
# verticalLayout(
# selectInput("mcc_month_l", "Month:",
# c("January" = "jan",
# "February" = "feb",
# "March" = "mar",
# "April" = "apr")
# ),
# plotlyOutput("mcc_l"),
# br(),
# formattableOutput("mcc_plt_l")
# ),
# verticalLayout(
# selectInput("mcc_month_r", "Month:",
# c("January" = "jan",
# "February" = "feb",
# "March" = "mar",
# "April" = "apr")
# ),
# plotlyOutput("mcc_r"),
# br(),
# formattableOutput("mcc_plt_r")
# )
# )),
# tabPanel(
# "Grocer Spendings",
# splitLayout(
# verticalLayout(
# selectInput("grocer", "Frequency:",
# c("Annually" = "annually",
# "Weekly" = "weekly",
# "Day of the Week" = "weekday")
# ),
# plotlyOutput("grocer_plt")
# ),
# verticalLayout(
# h3(strong("Summary of Graphs")),
# h4(em("Annual")),
# p("Analysis"),
# h4(em("Weekly")),
# p("analysis"),
# h4(em("Day of the Week")),
# p("analysis")
# )
# )
# ),
# tabPanel(
# "Walmart vs SNAP Users Map Overlay",
# style="padding: 20px",
# fluidRow(
# column(8,leafletOutput("facteus",height="80vh")),
# column(4, formattableOutput("facteus_plt"), style='white-space: normal; overflow-y: scroll; height: 80vh')
# )
# )
# )
# body_information <-
# sidebarLayout(
# position="right",
# sidebarPanel(
# width=3,
# h4(strong("External Resources")),
# p(a("USDA Website",href="https://www.fns.usda.gov/snap/supplemental-nutrition-assistance-program")),
# p(a("Application Resources by State", href="https://www.fns.usda.gov/snap/state-directory")),
# p(a("Feeding America",href="https://www.feedingamerica.org/take-action/advocate/federal-hunger-relief-programs/snap"))
# ),
# mainPanel(
# width=9,
# h3(strong("What is SNAP?")),
# p("SNAP stands for the Supplemental Nutrition Assistance Program, formerly known as food stamps. It is a federal nutrition program that relieves the financial burden of providing meals and groceries for lower-income families. SNAP benefits can be used to purchase food at grocery stores, convenience stores, and some farmers' markets and co-op food programs."),
# p("WIC is essentially SNAP for the supplemental needs of women, infants, and children. WIC provides federal grants to states for supplemental foods, health care referrals, and nutrition education for low-income pregnant, breastfeeding, and non-breastfeeding postpartum women, and to infants and children up to age five who are found to be at nutritional risk."),
# p("For more information, refer to the provided links on the right.")
# )
# )
# ui <-
# navbarPage(
# "Project SNAP",
# theme=shinytheme("flatly"),
# tabPanel(
# "Bay Area Study",
# body_bay
# ),
# tabPanel(
# "Shopping Patterns",
# body_shopping
# ),
# tabPanel(
# "What is SNAP?",
# body_information
# )
# )
#
# server <- function(input,output,session){
# output$snapmap <- renderLeaflet({ mpi })
# observeEvent(input$go,{
# loc <- geocode_OSM(input$address,as.sf = T)
# leafletProxy("snapmap") %>%
# removeShape(c("user_address","user_address_radius")) %>%
# addMarkers(
# lng=loc$lon,
# lat=loc$lat,
# icon=homeIcon,
# layerId="user_address") %>%
# addCircles(
# data=loc,
# lng = loc$lon,
# lat = loc$lat,
# color = "#81b1f3",
# weight = 0.25,
# radius = input$slider * 1609.344, # 2-mile radius
# fillOpacity = 0.5,
# label = paste(input$slider,"-mile radius"),
# highlightOptions =
# highlightOptions(
# weight = 2,
# opacity = 1
# ),
# layerId = "user_address_radius"
# ) %>%
# flyTo(loc$lon, loc$lat, zoom = 16-input$slider)
# })
#
# output$facteus <- renderLeaflet({ fp })
# output$facteus_plt <- renderFormattable({ walsnap_tbl })
# output$transactions <- renderPlot({ wplt })
# output$transactions2 <- renderPlotly({ ioplt })
# output$mcc_l <- renderPlotly({
# m <- input$mcc_month_l
# if (m == "jan") {
# jan$plt
# } else if (m == "feb") {
# feb$plt
# } else if (m == "mar") {
# mar$plt
# } else if (m == "apr") {
# apr$plt
# }
# })
# output$mcc_plt_l <- renderFormattable({
# m <- input$mcc_month_l
# if (m == "jan") {
# jan$tbl
# } else if (m == "feb") {
# feb$tbl
# } else if (m == "mar") {
# mar$tbl
# } else if (m == "apr") {
# apr$tbl
# }
# })
# output$mcc_r <- renderPlotly({
# m <- input$mcc_month_r
# if (m == "jan") {
# jan$plt
# } else if (m == "feb") {
# feb$plt
# } else if (m == "mar") {
# mar$plt
# } else if (m == "apr") {
# apr$plt
# }
# })
# output$mcc_plt_r <- renderFormattable({
# m <- input$mcc_month_r
# if (m == "jan") {
# jan$tbl
# } else if (m == "feb") {
# feb$tbl
# } else if (m == "mar") {
# mar$tbl
# } else if (m == "apr") {
# apr$tbl
# }
# })
# output$grocer_plt <- renderPlotly({
# m <- input$grocer
# if (m == "annually") {
# grocer_annual
# } else if (m == "weekly") {
# grocer_weekly
# } else if (m == "weekday") {
# grocer_weekday
# }
# })
#
# session$onSessionEnded(stopApp)
# }
#
# runApp(shinyApp(ui,server),launch.browser=T)